home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Caml Light 0.61 / Source / src / runtime / stacks.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-09-24  |  3.1 KB  |  111 lines  |  [TEXT/MPS ]
  1. /* To initialize and resize the stacks */
  2.  
  3. #include "config.h"
  4. #include "debugger.h"
  5. #include "fail.h"
  6. #include "misc.h"
  7. #include "mlvalues.h"
  8. #include "stacks.h"
  9.  
  10. value * arg_stack_low;
  11. value * arg_stack_high;
  12. value * arg_stack_threshold;
  13. value * ret_stack_low;
  14. value * ret_stack_high;
  15. value * ret_stack_threshold;
  16. value * extern_asp;
  17. value * extern_rsp;
  18. struct trap_frame * tp;
  19. value global_data;
  20.  
  21. void init_stacks()
  22. {
  23.   arg_stack_low = (value *) stat_alloc(Arg_stack_size);
  24.   arg_stack_high = arg_stack_low + Arg_stack_size / sizeof (value);
  25.   arg_stack_threshold = arg_stack_low + Arg_stack_threshold / sizeof (value);
  26.   extern_asp = arg_stack_high;
  27.   ret_stack_low = (value *) stat_alloc(Ret_stack_size);
  28.   ret_stack_high = ret_stack_low + Ret_stack_size / sizeof (value);
  29.   ret_stack_threshold = ret_stack_low + Ret_stack_threshold / sizeof (value);
  30.   extern_rsp = ret_stack_high;
  31.   tp = (struct trap_frame *) ret_stack_high;
  32. }
  33.  
  34. static void realloc_arg_stack()
  35. {        
  36.   asize_t size;
  37.   value * new_low, * new_high, * new_asp;
  38.   struct trap_frame * p;
  39.  
  40.   Assert(extern_asp >= arg_stack_low);
  41.   size = arg_stack_high - arg_stack_low;
  42.   if (size >= Max_arg_stack_size)
  43.     raise_out_of_memory();
  44.   size *= 2;
  45.   gc_message ("Growing argument stack to %ld kB.\n",
  46.           (long) size * sizeof(value) / 1024);
  47.   new_low = (value *) stat_alloc(size * sizeof(value));
  48.   new_high = new_low + size;
  49.  
  50. #define shift(ptr) \
  51.     ((char *) new_high - ((char *) arg_stack_high - (char *) (ptr)))
  52.  
  53.   new_asp = (value *) shift(extern_asp);
  54.   bcopy((char *) extern_asp,
  55.         (char *) new_asp,
  56.         (arg_stack_high - extern_asp) * sizeof(value));
  57.   stat_free((char *) arg_stack_low);
  58.   for (p = tp; p < (struct trap_frame *) ret_stack_high; p = p->tp)
  59.     p->asp = (value *) shift(p->asp);
  60.   arg_stack_low = new_low;
  61.   arg_stack_high = new_high;
  62.   arg_stack_threshold = arg_stack_low + Arg_stack_threshold / sizeof (value);
  63.   extern_asp = new_asp;
  64.  
  65. #undef shift
  66. }
  67.  
  68. static void realloc_ret_stack()
  69. {        
  70.   asize_t size;
  71.   value * new_low, * new_high, * new_rsp;
  72.   struct trap_frame * p;
  73.  
  74.   Assert(extern_rsp >= ret_stack_low);
  75.   size = ret_stack_high - ret_stack_low;
  76.   if (size >= Max_ret_stack_size)
  77.     raise_out_of_memory();
  78.   size *= 2;
  79.   gc_message ("Growing return stack to %ld kB.\n",
  80.           (long) size * sizeof(value) / 1024);
  81.   new_low = (value *) stat_alloc(size * sizeof(value));
  82.   new_high = new_low + size;
  83.  
  84. #define shift(ptr) \
  85.     ((char *) new_high - ((char *) ret_stack_high - (char *) (ptr)))
  86.  
  87.   new_rsp = (value *) shift(extern_rsp);
  88.   bcopy((char *) extern_rsp,
  89.         (char *) new_rsp,
  90.         (ret_stack_high - extern_rsp) * sizeof(value));
  91.   stat_free((char *) ret_stack_low);
  92.   tp = (struct trap_frame *) shift(tp);
  93.   for (p = tp; p < (struct trap_frame *) new_high; p = p->tp) {
  94.     p->tp = (struct trap_frame *) shift(p->tp);
  95.   }
  96.   ret_stack_low = new_low;
  97.   ret_stack_high = new_high;
  98.   ret_stack_threshold = ret_stack_low + Ret_stack_threshold / sizeof (value);
  99.   extern_rsp = new_rsp;
  100.  
  101. #undef shift
  102. }
  103.  
  104. void realloc_stacks()
  105. {
  106.   if (extern_rsp < ret_stack_threshold)
  107.     realloc_ret_stack();
  108.   if (extern_asp < arg_stack_threshold)
  109.     realloc_arg_stack();
  110. }
  111.